VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFileFunctions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Function FileDataToInsert(lngFailureReason As Long) As Boolean
'   This function checks if there are any files that have been received from SARS and are ready
'   to be inserted into the database
    
'   This program only inserts
'   1)  DR Directive Response files - contain:
'       Directive records (R) - (approved directive = length 305, declined directive = length 67)
'       Decline resons (E)
'   2)  VR Validation Response files - contain:
'       Decline resons (E) (very rarely - usually just Header and Trailer record))
'       These are only responses to the file format of the request file sent (is received almost immediately)
    
'   The InsertCancel program inserts responses to cancellation requests
'   Changed on 15/10/2001 to include Cancel responses in this program
    
    Dim strPathName As String
    Dim strFilename As String
    
    On Error GoTo FileDataToInsert_Fix
    
    'checks that the folder where we're about to look for the files received from SARS exists
    If LocationFolderExists Then
      strPathName = objReg.AsciiFileLocation
    Else
      lngFailureReason = RESPONSE_FILE_LOCATION_UNKNOWN
      HandleError Err.Number, Err.Description, "FileDataToInsert", "Response file location unknown."
      FileDataToInsert = False
      Exit Function
    End If
    
    objReg.ResponseFileType = ""
    
    Load frmShanksOpt
    frmShanksOpt.flbRecFiles.Path = strPathName
    frmShanksOpt.flbRecFiles.Refresh
        
    If Not ValidationResponseFileExists(strFilename) Then
        If Not CancelResponseFileExists(strFilename) Then
            If Not DirectiveResponseFileExists(strFilename) Then
                lngFailureReason = FILE_ERROR
                FileDataToInsert = False
                Unload frmShanksOpt
                Exit Function
            End If
        End If
    End If
    
    objReg.AsciiFileName = strFilename
    lngFileCount = lngFileCount + 1
    FileDataToInsert = True
    
    Unload frmShanksOpt
    Exit Function
    
FileDataToInsert_Fix:
    HandleError Err.Number, Err.Description, "FileDataToExtract"
    objReg.AsciiFileName = ""
    lngFailureReason = FILE_ERROR
    FileDataToInsert = False
End Function
Private Function ValidationResponseFileExists(strFilename As String) As Boolean

    Dim i As Integer
    Dim strExistingFile As String
    Dim strExpectedFileName As String

    Load frmShanksOpt
    frmShanksOpt.flbRecFiles.Pattern = "IRP3RSP.R*"
    frmShanksOpt.flbRecFiles.Refresh
        
    If frmShanksOpt.flbRecFiles.ListCount > 0 Then
        For i = 0 To frmShanksOpt.flbRecFiles.ListCount - 1
            strExistingFile = frmShanksOpt.flbRecFiles.List(i)
            objReg.ResponseFileType = "VR"
            strExpectedFileName = GetNextFileName()
            If strExistingFile = strExpectedFileName Then
                strFilename = strExistingFile
                ValidationResponseFileExists = True
                Exit Function
            End If
        Next i
        ValidationResponseFileExists = False
        HandleError 0, "Validation response files exist but not in the expected sequence", "ValidationResponseFileExists", "Expected file: " & strExpectedFileName
    Else
        ValidationResponseFileExists = False
    End If

End Function

Private Function DirectiveResponseFileExists(strFilename As String) As Boolean

    Dim i As Integer
    Dim strExistingFile As String
    Dim strExpectedFileName As String

    Load frmShanksOpt
    frmShanksOpt.flbRecFiles.Pattern = "IRP3DIRS.R*"
    frmShanksOpt.flbRecFiles.Refresh
                
    If frmShanksOpt.flbRecFiles.ListCount > 0 Then
        For i = 0 To frmShanksOpt.flbRecFiles.ListCount - 1
            strExistingFile = frmShanksOpt.flbRecFiles.List(i)
            objReg.ResponseFileType = "DR"
            strExpectedFileName = GetNextFileName()
            If strExistingFile = strExpectedFileName Then
                strFilename = strExistingFile
                DirectiveResponseFileExists = True
                Exit Function
            End If
        Next i
        DirectiveResponseFileExists = False
        HandleError 0, "Directive response files exist but not in the expected sequence", "DirectiveResponseFileExists", "Expected file: " & strExpectedFileName
    Else
        DirectiveResponseFileExists = False
    End If

End Function


Private Function CancelResponseFileExists(strFilename As String) As Boolean

    Dim i As Integer
    Dim strExistingFile As String
    Dim strExpectedFileName As String

    Load frmShanksOpt
    frmShanksOpt.flbRecFiles.Pattern = "IRP3CRP.R*"
    frmShanksOpt.flbRecFiles.Refresh
                
    If frmShanksOpt.flbRecFiles.ListCount > 0 Then
        For i = 0 To frmShanksOpt.flbRecFiles.ListCount - 1
            strExistingFile = frmShanksOpt.flbRecFiles.List(i)
            objReg.ResponseFileType = "CR"
            strExpectedFileName = GetNextFileName()
            If strExistingFile = strExpectedFileName Then
                strFilename = strExistingFile
                CancelResponseFileExists = True
                Exit Function
            End If
        Next i
        CancelResponseFileExists = False
        HandleError 0, "Cancel response files exist but not in the expected sequence", "CancelResponseFileExists", "Expected file: " & strExpectedFileName
    Else
        CancelResponseFileExists = False
    End If

End Function


Private Function GetNextFileName() As String

    Dim strNextFileName As String
    
    On Error GoTo GetNextFileName_Fix
    
    Select Case objReg.ResponseFileType
    
        Case "VR"
            strNextFileName = "IRP3RSP.R" & GetExpectedFileSeq()
            GetNextFileName = strNextFileName
        Case "DR"
            strNextFileName = "IRP3DIRS.R" & GetExpectedFileSeq()
            GetNextFileName = strNextFileName
        Case "CR"
            strNextFileName = "IRP3CRP.R" & GetExpectedFileSeq()
            GetNextFileName = strNextFileName
        Case Else
            MsgBox "Unknown Response Type", vbCritical
            End
    End Select
    
    Exit Function
GetNextFileName_Fix:
    GetNextFileName = ""
    HandleError Err.Number, Err.Description, "GetNextFileName"
End Function
Public Function GetExpectedFileSeq() As String

    Dim strSeqName As String
    Dim strSeq As String
    Dim strFillString As String
    Dim strSql As String
    Dim lngValue As Long
    Dim rsLastValue As ADODB.Recordset
    Dim lngRecordAffected As Long
    
    On Error GoTo GetExpectedFileSeqFix
    
    Select Case objReg.ResponseFileType
    
        Case "VR"
            strSeqName = "'DIR_IRP3RSP_SEQ'"
        Case "DR"
            strSeqName = "'DIR_IRP3DIRS_SEQ'"
        Case "CR"
            strSeqName = "'DIR_IRP3CRP_SEQ'"
        Case Else
            MsgBox "Unknown response type!!", vbCritical
            End
    End Select

    strSql = "Select LAST_VALUE from DIR_SEQUENCES where SEQ_NAME = " & strSeqName
    Set rsLastValue = objAdoConn.openrecordset(strSql)
    If rsLastValue.RecordCount > 0 Then
        If Not IsNull(rsLastValue!LAST_VALUE) Then
            If rsLastValue!LAST_VALUE <> 0 Then
                If rsLastValue!LAST_VALUE <> 999999 Then
                    lngValue = rsLastValue!LAST_VALUE + 1
                    strFillString = String(6, "0")
                    strSeq = Format(CStr(lngValue), strFillString)
                Else
                    strSeq = "000001"
                End If
            Else
                strSeq = "000001"
            End If
        Else
            strSeq = "000001"
        End If
    Else
        strSeq = "000001"
        strSql = "Insert into dir_sequences (SEQ_NAME, LAST_VALUE) values (" & strSeqName & ",0)"
        lngRecordAffected = objAdoConn.executequery(strSql)
    End If

    GetExpectedFileSeq = strSeq

    Exit Function
GetExpectedFileSeqFix:
  HandleError Err.Number, Err.Description, "GetExpectedFileSeq"
  GetExpectedFileSeq = ""
End Function

Public Function UpdateLastFileSeq() As Boolean

    Dim strLastDbSeq As String
    Dim strLastDbName As String
    Dim strSql As String
    Dim lngRecordsAffected As Long
    Dim strSeqName As String
    Dim strLastUsedName  As String

    On Error GoTo UpdateLastFileSeqFix

    
    strLastUsedName = objReg.AsciiFileName

    strLastDbSeq = GetExpectedFileSeq()

    Select Case objReg.ResponseFileType

        Case "VR"
            strSeqName = "'DIR_IRP3RSP_SEQ'"
            strLastDbName = "IRP3RSP.R" & strLastDbSeq
        Case "DR"
            strSeqName = "'DIR_IRP3DIRS_SEQ'"
            strLastDbName = "IRP3DIRS.R" & strLastDbSeq
        Case "CR"
            strSeqName = "'DIR_IRP3CRP_SEQ'"
            strLastDbName = "IRP3CRP.R" & strLastDbSeq
        Case Else
            MsgBox "Unknown Response Type", vbCritical
            End
    End Select
    
    If strLastUsedName = strLastDbName Then
        strSql = "Update DIR_SEQUENCES set LAST_VALUE = " & CDbl(strLastDbSeq) & " where SEQ_NAME = " & strSeqName
        lngRecordsAffected = objAdoConn.executequery(strSql)
        If lngRecordsAffected = 1 Then
            UpdateLastFileSeq = True
        Else
            HandleError Err.Number, Err.Description, "UpdateLastFileSeq", "Error executing: " & strSql
            UpdateLastFileSeq = False
        End If
    Else
        HandleError Err.Number, Err.Description, "UpdateLastFileSeq"
        UpdateLastFileSeq = False
    End If
    
    Exit Function
    
UpdateLastFileSeqFix:
    UpdateLastFileSeq = False
    HandleError Err.Number, Err.Description, "UpdateLastFileSeq"
End Function

Public Function ReadFile(strHeader As String, _
                        strFooter As String, _
                        colRecords As Collection, _
                        colDeclines As Collection) As Boolean

Dim strFileString As String
Dim FNumber As Long
Dim PathFileName As String
Static FileLineCount As Long
Dim strDetRecordType As String
Dim strDeclDescr As String

On Error GoTo Readfile_Fix

Set colRecords = Nothing
Set colRecords = New Collection
Set colDeclines = Nothing
Set colDeclines = New Collection

FileLineCount = 0
lngDeclineRecordCount = 0

'GET NEXT FILENUMBER
FNumber = FreeFile

PathFileName = objReg.AsciiFileLocation & objReg.AsciiFileName

'READ FILE
Open PathFileName For Input As FNumber
     'READ HEADER FROM FILE
    Line Input #FNumber, strHeader
    'PROCESS FILE DATA
    If GetHeader(strHeader) Then

        Do While Not EOF(FNumber)
            'READ A LINE FROM FILE
            Line Input #FNumber, strFileString
            If strFileString <> "" Then
                'PROCESS FILE DATA
                If GetRecord(strFileString, FileLineCount + 1, strDetRecordType, strDeclDescr) Then
                    Select Case strDetRecordType
                        Case "R"
                            FileLineCount = FileLineCount + 1
                            colRecords.Add strFileString, CStr(FileLineCount)
                        Case "E"
                            lngDeclineRecordCount = lngDeclineRecordCount + 1
                            colDeclines.Add strFileString, CStr(lngDeclineRecordCount)
                        Case "T"
                            strFooter = strFileString
                    End Select
                Else
                  Close #FNumber
                  ReadFile = False
                  Exit Function
                End If
            End If
        Loop
    Else
        Close #FNumber
        ProcessErrorFile
        ReadFile = False
        Exit Function
    End If
Close #FNumber

If objReg.ResponseFileType = "VR" Then
    If Not ProcessHeaderFile(strHeader, lngDeclineRecordCount, CLng(Right(strFooter, 8))) Then
      'renames, moves file and updates last fileseq
      ProcessErrorFile
    End If
    ReadFile = False
Else
    ReadFile = True
End If

Exit Function

Readfile_Fix:
    ReadFile = False
    HandleError Err.Number, Err.Description, "ReadFile"
End Function
Private Function GetHeader(strHeaderString As String) As Boolean

Dim intPos As Integer
Dim iColCount As Integer

On Error GoTo GetHeaderFix

    iColCount = 0
    'CHECK THAT THIS IS THE HEADER
    'new: no columns or quotes in file string
    If Mid(strHeaderString, 1, 1) <> "H" Then
        MsgBox "HEADER ERROR"
        GetHeader = False
        Exit Function
    End If
    
    'Cancel header strings are 303 in len - all nulls
    strHeaderString = RTrim(strHeaderString)
    If Len(strHeaderString) <> 79 Then
        GetHeader = False
    Else
        If Right(strHeaderString, 2) <> "01" Then
            GetHeader = False
        Else
            If ValidateHeader(strHeaderString) Then
                If RespFileNameProvided(strHeaderString) Then
                    If objReg.ResponseFileType = "VR" Then
                        GetHeader = True
                    Else
                        GetHeader = False
                    End If
                Else
                    If objReg.ResponseFileType = "VR" Then
                        GetHeader = False
                    Else
                        GetHeader = True
                    End If
                End If
            Else
                GetHeader = False
            End If
        End If
    End If
    
    Exit Function

GetHeaderFix:
    GetHeader = False
    HandleError Err.Number, Err.Description, "GetHeader"
End Function

Private Function GetFooter(strFileStmt As String) As Boolean

    Dim intPos As Integer
    Dim iColCount As Integer
    
    On Error GoTo GetFooter_Fix
    
    If Mid(strFileStmt, 1, 1) <> "T" Then
        GetFooter = False
        Exit Function
    End If

    Select Case objReg.ResponseFileType
        Case "DR"
            If Len(strFileStmt) = 165 Then
                GetFooter = True
            Else
                'DR: max record len is 600
                If Len(strFileStmt) = 600 Then
                    MsgBox "Trailer record is max record length: " & Len(strFileStmt)
                    GetFooter = True
                Else
                    GetFooter = False
                End If
            End If
        Case "CR"
            If Len(strFileStmt) = 303 Then
                GetFooter = True
            Else
                'CR: max record len is 400
                If Len(strFileStmt) = 400 Then
                    MsgBox "Trailer record is max record length: " & Len(strFileStmt)
                    GetFooter = True
                Else
                    GetFooter = False
                End If
            End If
        Case "VR"
            'table 2.28 section 3.2.5.11.3 page 3-54 says the trailer record should be 9 in length
            If Len(strFileStmt) <> 9 Then
                'Table 3-4 in the specification - section 3.2.5.3 says max len is 120
                'for some reason the footer is 120 - phil says this is correct (go figure)
                
                'okay, that was dev, in prod the footer length is now 600 (?)
                If Len(strFileStmt) <> 120 Then
                    If Len(strFileStmt) <> 600 Then
                        GetFooter = False
                    Else
                        GetFooter = True
                    End If
                Else
                    GetFooter = True
                End If
            Else
                GetFooter = True
            End If
    End Select
    
    Exit Function

GetFooter_Fix:
    GetFooter = False
    HandleError Err.Number, Err.Description, "GetFooter"
End Function

Private Function GetDeclDesc(strFileStmt As String, strDeclText As String) As Boolean

    Dim intPos As Integer
    Dim iColCount As Integer
    
    On Error GoTo GetDeclDesc_Fix
    
    If Mid(strFileStmt, 1, 1) <> "E" Then
        GetDeclDesc = False
        Exit Function
    End If

    'barb: watch this
    '111 in a perfect world
    '46 in len before err-text (err-text is the field who's len can vary)
    'so len must be something between 46 and 111
    'first is 77
    'okay in production this is 65 in length
    If Len(strFileStmt) > 46 Then
        If Len(strFileStmt) <= 111 Then
'            strDeclNo = Mid(strFileStmt, 42, 5)
'            strDeclText = Mid(strFileStmt, 47, 65)
'            strDeclText = Trim(strDeclText)
            strDeclText = strFileStmt
            GetDeclDesc = True
        Else
            GetDeclDesc = False
        End If
    Else
        GetDeclDesc = False
    End If

    Exit Function

GetDeclDesc_Fix:
    GetDeclDesc = False
    HandleError Err.Number, Err.Description, "GetDeclDesc"
End Function


'Private Function GetRecord(FileStmt As String, lngLineCount As Long, strRecordType As String, strDeclNo As String, strDeclDesc As String) As Boolean
Private Function GetRecord(FileStmt As String, lngLineCount As Long, strRecordType As String, strDeclDesc As String) As Boolean

Dim intPos As Integer
Dim iColCount As Integer

Dim arLastRecord()

On Error GoTo GetRecordFix
            
    If Mid(FileStmt, 1, 1) <> "R" Then
        If Mid(FileStmt, 1, 1) = "T" Then
            If GetFooter(FileStmt) Then
                GetRecord = True
                strRecordType = "T"
                Exit Function
            Else
                GoTo GetRecordFix
            End If
        Else
            'CHANGES AS PER SARS FOR 5/7/2001
            If Mid(FileStmt, 1, 1) = "E" Then
                If GetDeclDesc(FileStmt, strDeclDesc) Then
                    GetRecord = True
                    strRecordType = "E"
                    Exit Function
                Else
                    GoTo GetRecordFix
                End If
            Else
                GoTo GetRecordFix
            End If
            GoTo GetRecordFix
        End If
        GoTo GetRecordFix
    End If

    'CHANGES AS PER SARS FOR 5/7/2001
    'If Len(strFixedRecord) = 292 Then   'if approved'1315 including chr(13)
    '305 for DR records, 303 for CR records
    If Len(FileStmt) = 305 Or Len(FileStmt) = 303 Then   'if approved'1315 including chr(13)
        GetRecord = True
        strRecordType = "R"
    Else
        'If Len(strFixedRecord) = 69 Then 'if declined
        'If Len(FileStmt) = 82 Then 'if declined
        'T'would appear that the new (5/7/2001) decline str len is 67
        If Len(FileStmt) = 67 Then 'if declined
            GetRecord = True
            strRecordType = "R"
        Else
            GetRecord = False
        End If
    End If
Exit Function

GetRecordFix:
    GetRecord = False
    HandleError Err.Number, Err.Description, "GetRecord", , lngLineCount
End Function

Public Function FileCleanUp() As Boolean
'   set the last successful filename in database
'   rename or move last successful file
    
    On Error GoTo FileCleanUp_Fix
    
    Dim strSuffix As String
    Dim strNewFileName As String
    Dim strPath As String
    Dim strOldFileName As String
    Dim strArchivePath As String
        
    strPath = objReg.AsciiFileLocation
    strOldFileName = objReg.AsciiFileName
    
    strArchivePath = objReg.ArchiveFileLocation
    strSuffix = Right(strOldFileName, 6)
    strNewFileName = Left(strOldFileName, Len(strOldFileName) - 7) & "A" & strSuffix
    
    Name strPath & strOldFileName As strArchivePath & strNewFileName '- moves And renames
    
    If UpdateLastFileSeq Then
        FileCleanUp = True
    End If
    
    Exit Function
FileCleanUp_Fix:
    FileCleanUp = False
    HandleError Err.Number, Err.Description, "FileCleanUp"
End Function
Public Function ProcessErrorFile() As String

'   if validation response file indicates that an error has occurred
'   or any other file
'   update file sequence and rename file
'   returns new error filename

    Dim strNewFileName As String
    Dim strOldFileName As String

    On Error GoTo ProcessErrorFileFix
        
    lngErrorCount = lngErrorCount + 1
    
    strOldFileName = objReg.AsciiFileName
    
        If RenameToErrorFile(strOldFileName, strNewFileName) Then
            If Not UpdateLastFileSeq Then
                MsgBox "Error updating UpdateLastFileSeq on error file."
            Else
                ProcessErrorFile = strNewFileName
            End If
        End If

    Exit Function

ProcessErrorFileFix:
  HandleError Err.Number, Err.Description, "ProcessErrorFile"
End Function
Public Function RenameToErrorFile(strCurrentFilename As String, strMoveToFileName As String) As Boolean

    Dim strSuffix As String
    Dim strNewFileName As String
    Dim strPath As String
    Dim strErrorPath As String

    On Error GoTo RenameToErrorFileFix
  
    'get current path - check if file is there
    strPath = objReg.AsciiFileLocation
    If strPath = "" Then
        RenameToErrorFile = False
        Exit Function
    End If
    If Dir(strPath & strCurrentFilename) = "" Then
        RenameToErrorFile = False
        Exit Function
    End If
    
    strErrorPath = objReg.ErrorFileLocation
    strSuffix = Right(strCurrentFilename, 6)
    strNewFileName = Left(strCurrentFilename, Len(strCurrentFilename) - 7) & "E" & strSuffix
    Name strPath & strCurrentFilename As strErrorPath & strNewFileName   '- moves And renames
    strMoveToFileName = strErrorPath & strNewFileName
    
    lngFileCount = lngFileCount - 1
    
    RenameToErrorFile = True
    
    Exit Function
    
RenameToErrorFileFix:
    RenameToErrorFile = False
    HandleError Err.Number, Err.Description, "RenameToErrorFile"
End Function
Private Function LocationFolderExists() As Boolean
'   Check that the directory to search for incoming files from sars
'   exists, else pop up form for new dir or create one

    Dim strCurrentRegFolder As String

    '\\LIB_NT_01\USERS\BJM0509\Temp

    On Error GoTo LocationFolderExistsFix

    strCurrentRegFolder = objReg.AsciiFileLocation

    If strCurrentRegFolder = "" Then
        frmDirType.Show vbModal
        If Not frmDirType.blnCancel Then
            strCurrentRegFolder = frmDirType.strDir
        Else
            LocationFolderExists = False
            Exit Function
        End If
    End If
    
        If ValidLocationFolder(strCurrentRegFolder) Then
            objReg.AsciiFileLocation = strCurrentRegFolder
            LocationFolderExists = True
        Else
            LocationFolderExists = False
        End If
    
    Exit Function
LocationFolderExistsFix:
    LocationFolderExists = False
    HandleError Err.Number, Err.Description, "LocationFolderExists"
End Function
Private Function ValidLocationFolder(strFolder As String) As Boolean

  On Error GoTo ValidLocationFolderFix

    'CHECK IF DIR EXISTS, ELSE CREATE?
    If Dir(strFolder, vbDirectory) = "" Then
        frmDirType.strDir = strFolder
        frmDirType.Show vbModal
        If frmDirType.blnCancel Then
            ValidLocationFolder = False
            Exit Function
        Else
          strFolder = frmDirType.strDir
        End If
    Else
        If Right(strFolder, 1) <> "\" Then
            strFolder = strFolder & "\"
        End If
    End If
    
    ValidLocationFolder = True
    
    Exit Function
ValidLocationFolderFix:
    ValidLocationFolder = False
    HandleError Err.Number, Err.Description, "ValidLocationFolder"
End Function

Private Function ValidateHeader(strHead) As Boolean

  Dim strFileSysId As String
  Dim strFileTestData As String
  Dim strDbSysId As String
  Dim strDbTestData As String
  Dim rsSystemParameters As ADODB.Recordset
  Dim strSql As String
  Dim lngRecordsAffected As Long
  Dim rsTemp  As ADODB.Recordset

  On Error GoTo ValidateHeaderFix

    strSql = "Select VAR_VALUE from DIR_PARAMETERS where CODE = 'ISP0901'"
    Set rsSystemParameters = objAdoConn.openrecordset(strSql)
    If rsSystemParameters.RecordCount > 0 Then
        If Not IsNull(rsSystemParameters!VAR_VALUE) Then
            strDbSysId = rsSystemParameters!VAR_VALUE
        Else
            HandleError Err.Number, Err.Description, "ValidateHeader", "No value for ISP0901 in DIR_PARAMETERS."
            ValidateHeader = False
            Exit Function
        End If
    Else
        HandleError Err.Number, Err.Description, "ValidateHeader", "No value for ISP0901 in DIR_PARAMETERS."
        ValidateHeader = False
        Exit Function
    End If
    
    strSql = "Select VAR_VALUE from DIR_PARAMETERS where CODE = 'TEST_DATA'"
    Set rsSystemParameters = objAdoConn.openrecordset(strSql)
    If rsSystemParameters.RecordCount > 0 Then
        If Not IsNull(rsSystemParameters!VAR_VALUE) Then
            strDbTestData = rsSystemParameters!VAR_VALUE
            If Len(strDbTestData) <> 1 Then
                HandleError Err.Number, Err.Description, "ValidateHeader", "No value for TEST_DATA in DIR_PARAMETERS."
                ValidateHeader = False
                Exit Function
            End If
        Else
            HandleError Err.Number, Err.Description, "ValidateHeader", "No value for TEST_DATA in DIR_PARAMETERS."
            ValidateHeader = False
            Exit Function
        End If
    Else
        MsgBox "System Parameter Error"
        ValidateHeader = False
        Exit Function
    End If
    
    strFileSysId = Mid(strHead, 20, 8)
    strFileTestData = Mid(strHead, 18, 1)
    
    If strFileSysId = strDbSysId Then
      If strFileTestData = strDbTestData Then
        ValidateHeader = True
      Else
        HandleError Err.Number, Err.Description, "ValidateHeader", "Incorrect Test Data Identifier.Expecting test data:" & strDbTestData
        ValidateHeader = False
      End If
    Else
      HandleError Err.Number, Err.Description, "ValidateHeader", "Incorrect System Identifier."
      ValidateHeader = False
    End If
    
    Exit Function
    
ValidateHeaderFix:
    HandleError Err.Number, Err.Description, "ValidateHeader"
    ValidateHeader = False
End Function
Private Function ProcessHeaderFile(ResponseToFile As String, NoOfErrRecs As Long, NoOfErrs As Long) As Boolean

  Dim strSql As String
  Dim rsTemp As ADODB.Recordset
  Dim lngRecordsAffected As Long

    If NoOfErrRecs <> NoOfErrs Then
        ProcessHeaderFile = False
        Exit Function
    End If

    If NoOfErrs = 0 Then
        'process validation ok file
        ResponseToFile = Trim(ResponseToFile)
        'Validation responses to Cancels: Cancel file names are 1 len longer, SARS chops off the first letter - add I in front
        If Left(ResponseToFile, 7) = "RP3CRQ." Then
            ResponseToFile = "I" & ResponseToFile
        End If
        If ResponseToFile <> "" Then
          strSql = "Select max(REQ_SEQ_NUM) from DIR_REQUEST"
          strSql = strSql & " WHERE REQ_FILE_NAME = '" & ResponseToFile & "'"
          Set rsTemp = objAdoConn.openrecordset(strSql)
          If rsTemp.RecordCount > 0 Then
            If Not IsNull(rsTemp(0)) Then
              strSql = "Update DIR_REQUEST "
              strSql = strSql & " set process_status_date = GETDATE(),"
              strSql = strSql & " scod_process_status = 'FA'"
              strSql = strSql & " where REQ_FILE_NAME = '" & ResponseToFile & "'"
              'bjm: added this in on 02/01/2002 in case SARS send the header file after they send the Directive file
              'ie if status is already Received from Sars, don't update
              'barb: watch this
              strSql = strSql & " and SCOD_PROCESS_STATUS <> 'RS'"
              lngRecordsAffected = objAdoConn.executequery(strSql)
              'If lngRecordsAffected > 0 Then
                'this is a header header - exit and move onto next file
                  If FileCleanUp Then
                      ProcessHeaderFile = True
                  Else
                      HandleError Err.Number, Err.Description, "ProcessHeaderFile", "File clean up failed for header file."
                      ProcessHeaderFile = False
                  End If
              'Else
                'directives already received and processed
                'don't need to update status and dttm to 'FA'
                'HandleError Err.Number, Err.Description, "ProcessHeaderFile", "Unable to update Request.Process status for header file."
              '  ProcessHeaderFile = True
              'End If
            Else
              HandleError Err.Number, Err.Description, "ProcessHeaderFile", "Filename in header that doesn't exist in database"
              ProcessHeaderFile = False
            End If
          Else
            HandleError Err.Number, Err.Description, "ProcessHeaderFile", "Filename in header that doesn't exist in database"
            ProcessHeaderFile = False
          End If
        End If
    Else
        'process validation error file
        MsgBox "File error descriptions were listed in Validation Response File: " & objReg.AsciiFileName & vbCrLf & _
        "These file error desciptions refer to Request File: " & ResponseToFile & vbCrLf & _
        "Please investigate before continuing."
        ProcessHeaderFile = False
    End If


End Function
Private Function RespFileNameProvided(strHeaderString As String) As Boolean

    Dim strPreviousReqFileName As String

    'check for VR File
    'VR files contain a filename in resp filename
    'DR files have blank resp filenames
    'CR files also have blank resp filenames
    strPreviousReqFileName = Mid(strHeaderString, 64, 14)
    If Trim(strPreviousReqFileName) <> "" Then
          strHeaderString = Trim(strPreviousReqFileName)
          RespFileNameProvided = True
          Exit Function
    Else
        RespFileNameProvided = False
    End If

End Function
